home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / prog / pas_all.zip / TI669.ASC < prev    next >
Text File  |  1992-02-28  |  3KB  |  199 lines
  1.  
  2.  
  3.  
  4.  
  5.  
  6.  
  7.  
  8.   PRODUCT  :  Turbo Pascal                           NUMBER  :  669
  9.   VERSION  :  6.0
  10.        OS  :  MS/PC DOS
  11.      DATE  :  February 28, 1992                        PAGE  :  1/3
  12.  
  13.     TITLE  :  Change Menubar at Runtime
  14.  
  15.  
  16.  
  17.  
  18.   {
  19.  
  20.   This program changes the menubar at runtime as well
  21.   as demonstrates how to create a menuitem that does not
  22.   have a submenu.
  23.  
  24.   }
  25.   {$X+}
  26.   program ExampleProgram;
  27.  
  28.   uses
  29.     Drivers, Objects, Views, App, Menus, Puzzle, Calendar;
  30.     const
  31.     PuzzleCmd   = 100;
  32.     CalendarCmd = 101;
  33.     SwitchCmd   = 102;
  34.  
  35.   type
  36.     TTestMain = object(TApplication)
  37.       OtherMenu: PMenuBar;
  38.       constructor Init;
  39.       procedure Calendar;
  40.       procedure HandleEvent(var Event: TEvent); virtual;
  41.       procedure InitMenuBar; virtual;
  42.       procedure Puzzle;
  43.       procedure SwitchMenu;
  44.     end;
  45.  
  46.   { TTestMain }
  47.   constructor TTestMain.Init;
  48.   begin
  49.     TApplication.Init;
  50.   end;
  51.  
  52.   procedure TTestMain.Calendar;
  53.   var
  54.     CalendarWindow: PCalendarWindow;
  55.   begin
  56.     CalendarWindow := new(PCalendarWindow, Init);
  57.     DeskTop^.Insert(CalendarWindow);
  58.   end;
  59.  
  60.   procedure TTestMain.HandleEvent(var Event: TEvent);
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.   PRODUCT  :  Turbo Pascal                           NUMBER  :  669
  75.   VERSION  :  6.0
  76.        OS  :  MS/PC DOS
  77.      DATE  :  February 28, 1992                        PAGE  :  2/3
  78.  
  79.     TITLE  :  Change Menubar at Runtime
  80.  
  81.  
  82.  
  83.  
  84.   begin
  85.     TApplication.HandleEvent(Event);
  86.     if Event.What = evCommand Then
  87.     begin
  88.       case Event.Command of
  89.         PuzzleCmd   : Puzzle;
  90.         CalendarCmd : Calendar;
  91.         SwitchCmd   : SwitchMenu;
  92.       else
  93.         Exit;
  94.       end;
  95.       ClearEvent(Event);
  96.     end;
  97.   end;
  98.  
  99.   Procedure TTestMain.InitMenuBar;
  100.   var
  101.     R: TRect;
  102.   begin
  103.     GetExtent(R);
  104.     R.B.Y := R.A.Y+1;
  105.     MenuBar := New(PMenuBar, Init(R, NewMenu(
  106.        NewItem('~S~witch Menus','', 0, SwitchCmd, hcNoContext,
  107.        NewSubMenu('~E~xample',hcNoContext,NewMenu(
  108.        NewItem('~P~uzzle','', 0, PuzzleCmd, hcNoContext,
  109.        NewItem('~C~alendar','', 0, CalendarCmd, hcNoContext,
  110.        NewLine(
  111.        NewItem('~Q~uit', '',0, cmQuit,
  112.   hcNoContext,Nil))))),Nil)))));
  113.     OtherMenu := New(PMenuBar, Init(R, NewMenu(
  114.        NewItem('~S~witch Menus','', 0, SwitchCmd, hcNoContext,
  115.        NewSubMenu('~O~ther Menu',hcNoContext,NewMenu(
  116.        NewItem('~B~y', '', 0, cmQuit, hcNoContext,
  117.        NewLine(
  118.        NewItem('~Q~uit', '',0, cmQuit,
  119.   hcNoContext,Nil)))),Nil)))));
  120.   end;
  121.  
  122.   procedure TTestMain.Puzzle;
  123.   var
  124.    PuzzleWindow: PPuzzleWindow;
  125.   begin
  126.     PuzzleWindow := new(PPuzzleWindow, Init);
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.   PRODUCT  :  Turbo Pascal                           NUMBER  :  669
  141.   VERSION  :  6.0
  142.        OS  :  MS/PC DOS
  143.      DATE  :  February 28, 1992                        PAGE  :  3/3
  144.  
  145.     TITLE  :  Change Menubar at Runtime
  146.  
  147.  
  148.  
  149.  
  150.     DeskTop^.Insert(PuzzleWindow);
  151.   end;
  152.  
  153.   procedure TTestMain.SwitchMenu;
  154.   var
  155.     Temp: PMenuBar;
  156.   begin
  157.     Delete(MenuBar);
  158.     Temp := PMenuBar(MenuBar);
  159.     MenuBar := OtherMenu;
  160.     OtherMenu := Temp;
  161.     Insert(MenuBar);
  162.     MenuBar^.DrawView;
  163.   end;
  164.  
  165.   var
  166.     TestMain: TTestMain;
  167.  
  168.   begin
  169.     TestMain.Init;
  170.     TestMain.Run;
  171.     TestMain.Done;
  172.   end.
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  
  190.  
  191.  
  192.  
  193.  
  194.  
  195.  
  196.  
  197.  
  198.  
  199.